home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1997-08-08 | 63.3 KB | 2,020 lines
; ; Hey men ! This isen't a Protacker music module but an Oberon-II source file !!! ; .key CMD/A .bra { .ket } If {CMD} EQ "Lnk" IF `RequestChoice TITLE "Link" BODY "Run ?" GADGETS "Y|N"` EQ "1" Skip Rn EndIf Skip Lnk EndIf FailAt 11 Stack 16384 Oberon-A:OC Main.mod ;NS If Warn Skip Errs EndIf Lab Lnk Blink WITH /Divers/MainAll.withs IF `RequestChoice TITLE "Linked" BODY "Run ?" GADGETS "Y|N"` EQ "0" Quit EndIf Lab Rn /Main Quit Lab Errs Oberon-A:OEL Main Quit (* :: >> Utiliser les fonctions dos asynchrones pour le stockage des préfs *) <*STANDARD-*> <*MAIN+*> MODULE Main; IMPORT E := Exec, dos := Dos, L := Localize, U := Utility, str := Strings, sys := SYSTEM, T := Triton_nl, com := Commodities, s := Sets, Util, Icon, <* IF TEST THEN *> WBConsole, <* END *> Workbench, int := Intuition, asl := Asl_nl, Kernel, Errors; CONST noMemN = 00; noMemS = "Not enough memory"; emptyN = 01; emptyS = "<Empty>"; watchedN = 02; watchedS = "Watched Files:"; lvHlpN = 03; lvHlpS = "List of files to start notification on."; pathN = 04; pathS = "Path:"; pathHlpN = 05; pathHlpS = "Path of the notified file."; fileN = 06; fileS = "File:"; fileHlpN = 07; fileHlpS = "Enter here the file on which\nthe notification should be started."; aslfHlpN = 08; aslfHlpS = "Select the files easily with\nthe asl-filerequester."; exesN = 09; exesS = "Execute:"; exesHlpN = 10; exesHlpS = "AmigaDOS command to execute\nwhen a file is modified.\nThe output is by default directed to NIL:\nYou can redirect it using a '>' character."; aslcHlpN = 11; aslcHlpS = "Select the commands easily\nwith the asl-filerequester."; exeN = 12; exeS = "Execute"; exeHlpN = 13; exeHlpS = "Use this button to execute\nthe specifed command now !\nNote: MultiNotify won't wait\nthe end of the execution"; newN = 14; newS = "New"; newHlpN = 15; newHlpS = "Adds a new notification-file to the list"; delN = 16; delS = "Delete"; delHlpN = 17; delHlpS = "Suppress the selected item of the list."; savN = 18; savS = "Save"; savHlpN = 19; savHlpS = "Save the current settings definitely."; useN = 20; useS = "Use"; useHlpN = 21; useHlpS = "Save the current settings\ntemporarily (only to ENV:)\nThe modifications will\nbe lost after a reboot."; hidN = 22; hidS = "Hide"; hidHlpN = 23; hidHlpS = "Hide the interface. You can reopen this window\nusing the Commodities/Exchange program.\nNote: The modifications won't take effect now."; canN = 24; canS = "Cancel"; canHlpN = 25; canHlpS = "Undoes all the current modifications.\nThe previous configuration is loaded again."; okN = 26; okS = "Ok"; prfCrptN = 27; prfCrptS = "Prefs file is corrupted."; cfgSErrN = 28; cfgSErrS = "Can't save configuration file."; exeErrN = 29; exeErrS = "Can't execute specified command."; SEnvarcErrN = 30; SEnvarcErrS = "Unable to save config to ENVARC:"; SEnvErrN = 31; SEnvErrS = "Unable to save config to ENV:"; LEnvErrN = 32; LEnvErrS = "Unable to load config file from ENV:"; intTrErrN = 33; intTrErrS = "Internal Triton error"; noTrLibN = 34; noTrLibS = "Can't open version 6 of triton.library.\nThis library must be installed in LIBS:\nor in the directory of the application."; noTrIntN = 35; noTrIntS = "Can't initialize Triton interface."; noAslLibN = 36; noAslLibS = "Can't open asl.library."; TTBubName = "HELPBUBBLES"; configLName = "ENV:MultiNotify.prefs"; configSName = "ENVARC:MultiNotify.prefs"; envarc = TRUE; env = ~envarc; (* pour sauvegarde des prefs *) appName = "MultiNotify"; winTitle = "MultiNotify 1.0 © BURNAND Patrick"; appTitle = "The AmigaDOS file Watcher"; winID = 1; (* fenêtre de l'app *) lvID = 1; (* gadget ListView *) fileStrID = 2; (* string gadget fichier à surveiller *) getffileID = 3; (* gadget GetFile du fichier à surveiller *) exeStrID = 4; (* string gadget du fichier à exécuter *) getfexeID = 5; (* gadget GetFile du fichier à exécuter *) exebuttID = 6; (* button Execute *) newbuttID = 7; (* button New *) delbuttID = 8; (* button New *) savebuttID = 9; (* button Save *) usebuttID = 10; (* button Use *) hidebuttID = 11; (* button Hide *) cancbuttID = 12; (* button Cancel *) pathStrID = 13; (* string gadget chemin du fichier à surveiller *) internalVer = 4; (* Version du catalog et fichier préférences *) TYPE _path = ARRAY 258 OF CHAR; _name = ARRAY 32 OF CHAR; _cmd = ARRAY 258 OF CHAR; (* données à sauver sur disk *) _FilePtr = POINTER TO _File; _File = RECORD path : _path; name : _name; cmd : _cmd; END; (* ne doit pas être sauvé dans les préfs *) _notify = RECORD n : dos.NotifyRequest; (* *) ok : BOOLEAN; (* la demande de notification a fonctionné *) END; (* élément de la liste chaînée *) _FileNodePtr = POINTER TO _FileNode; _FileNode = RECORD node : E.Node; file : _File; (* sauvés sur disk *) notify : _notify; END; _projTags = ARRAY 122 OF U.TagItem; (* >=122 *) VAR FileListHeader : E.MinList; (* n'est pas un élément de la liste *) locStrPtr : E.LSTRPTR; (* stockage temp chaîne localisée *) openNow : BOOLEAN; (* indique s'il faut ouvrir l'interface immédiatement *) BrokerPortPtr : E.MsgPortPtr; (* Interface Commoditites *) BrokerPtr : com.CxObjPtr; (* *) NewBroker : com.NewBroker; (* *) BrokerWaitSig : SET; (* Signal à attendre de Exchange *) NotifyMsgPortPtr : E.MsgPortPtr; (* Port sur lequel on reçoit la notification *) NotifyWaitSig : SET; StartNotify : BOOLEAN; (* Var temporaire pour la fonction NotifyAllNow *) projTagsPtr : POINTER TO _projTags; (* Init interface Triton *) application : T.AppPtr; mainProject : T.ProjectPtr; actlvID : E.ULONG; (* Élément actuellement sélectionné dans le listview *) guiOpened : BOOLEAN; (* Indique si l'interface est ouverte (pour CloseGui()) *) TT : RECORD (* Tooltypes *) Bubbles : BOOLEAN; (* Bulles d'aides activées *) END; (* crée le tableaux de Tags pour Triton. tags doit avoir une longueur suffisante *) <*$CopyArrays-*> PROCEDURE InitGuiTags (tags: ARRAY OF U.TagItem) ; VAR tagNum : INTEGER; BEGIN tagNum := 0; tags[tagNum].tag := T.wiID; tags[tagNum].data := winID; INC(tagNum); tags[tagNum].tag := T.wiTitle; tags[tagNum].data := sys.ADR(winTitle); INC(tagNum); tags[tagNum].tag := T.wiBackfill; tags[tagNum].data := T.bfWindowBack; INC(tagNum); tags[tagNum].tag := T.wiPosition; tags[tagNum].data := T.wpCenterDisplay; INC(tagNum); tags[tagNum].tag := T.wiQuickHelp; tags[tagNum].data := 0; IF TT.Bubbles THEN tags[tagNum].data := 1 END; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.grVert; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign (*+ T.grCenter*); INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grVert; tags[tagNum].data := T.grPropShare + T.grAlign (*+ T.grCenter*); INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obFrameBox; tags[tagNum].data := T.fbFraming; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(watchedN, watchedS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.grVert; tags[tagNum].data := T.grPropShare + T.grAlign (*+ T.grCenter*); INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obListview; tags[tagNum].data := sys.ADR(FileListHeader); INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := lvID; INC(tagNum); tags[tagNum].tag := T.atFlags; tags[tagNum].data := T.lvShowSelected + (*T.lvFWFont +*) T.lvNoGap; INC(tagNum); tags[tagNum].tag := T.atMinWidth; tags[tagNum].data := 10; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(lvHlpN, lvHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atValue; tags[tagNum].data := 0; (* devrait contenir le dernier item sélectionné *) INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obText; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(pathN, pathS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atFlags; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obString; locStrPtr := L.CatStr(emptyN, emptyS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atValue; tags[tagNum].data := SIZE(_path); INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := pathStrID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(pathHlpN, pathHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obText; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(fileN, fileS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atFlags; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obString; locStrPtr := L.CatStr(emptyN, emptyS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atValue; tags[tagNum].data := SIZE(_name); INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := fileStrID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(fileHlpN, fileHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := T.btGetFile; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := getffileID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(aslfHlpN, aslfHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign + T.grCenter; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obText; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(exesN, exesS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atFlags; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obString; locStrPtr := L.CatStr(emptyN, emptyS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atValue; tags[tagNum].data := SIZE(_cmd); INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := exeStrID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(exesHlpN, exesHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := T.btGetFile; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := getfexeID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(aslcHlpN, aslcHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign (*+ T.grCenter*); INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(exeN, exeS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := exebuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(exeHlpN, exeHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(newN, newS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := newbuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(newHlpN, newHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(delN, delS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := delbuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(delHlpN, delHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grHoriz; tags[tagNum].data := T.grPropShare + T.grAlign (*+ T.grCenter*); INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(savN, savS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := savebuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(savHlpN, savHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(useN, useS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := usebuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(useHlpN, useHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(hidN, hidS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := hidebuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(hidHlpN, hidHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stSmall; INC(tagNum); tags[tagNum].tag := T.obButton; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.atText; locStrPtr := L.CatStr(canN, canS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.atID; tags[tagNum].data := cancbuttID; INC(tagNum); tags[tagNum].tag := T.doQuickHelpString; locStrPtr := L.CatStr(canHlpN, canHlpS); tags[tagNum].data := locStrPtr; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.obSpace; tags[tagNum].data := T.stNormal; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := T.grEnd; tags[tagNum].data := 0; INC(tagNum); tags[tagNum].tag := U.done; tags[tagNum].data := 0; END InitGuiTags; (* Évite les sys.VAL() sauvages *) PROCEDURE [0] ConvPtr (p1: sys.ADDRESS ; VAR p2: sys.LONGWORD); <*$CopyArrays-*> BEGIN p2:=p1 END ConvPtr; (* Initialise la liste chaînée à vide *) PROCEDURE [0] InitHeader (); <*$CopyArrays-*> BEGIN (* initialisation de l'entête de la liste chaînée *) FileListHeader.head := sys.ADR(FileListHeader.tail); FileListHeader.tail := NIL; FileListHeader.tailPred := sys.ADR(FileListHeader); END InitHeader; (* Écrit size fois la valeur 0 à partir de adr *) PROCEDURE [0] InitMem (adr: sys.ADDRESS ; size: LONGINT); <*$CopyArrays-*> TYPE memptr = POINTER TO ARRAY OF SHORTINT; VAR i : LONGINT; adr2 : memptr; BEGIN <*$ <IndexChk- *> ConvPtr (adr, adr2); FOR i := 0 TO size-1 DO adr2[i] := 0 END; <*$ > *> END InitMem; (* Lit les tooltypes si l'icône est disponible et remplit la structure TT *) PROCEDURE [0] GetTT (); <*$CopyArrays-*> VAR oldDir : dos.FileLockPtr; diskObj : Workbench.DiskObjectPtr; wbMsg : Workbench.WBStartupPtr; tt : E.LSTRPTR; BEGIN TT.Bubbles := FALSE; IF Kernel.fromWorkbench THEN wbMsg := Kernel.WBenchMsg; (* First CD to the app's directory *) oldDir := dos.CurrentDir (wbMsg.argList[0].lock); (* Attempt to load the app's icon *) diskObj := Icon.GetDiskObject (wbMsg.argList[0].name^); IF diskObj # NIL THEN tt := Icon.FindToolType (diskObj.toolTypes, TTBubName); TT.Bubbles := tt#NIL; (* We will free diskObj AFTER we have finished with console. *) END; (* Back to where we started *) oldDir := dos.CurrentDir (oldDir); IF diskObj # NIL THEN Icon.FreeDiskObject (diskObj) END; END; END GetTT; (* :: Retoune TRUE si la liste entrée en paramètres est vide. Elle est vide si elle ne contient pas :: d'éléments à part l'entête. *) PROCEDURE [0] listIsEmpty (lst : E.MinListPtr) : BOOLEAN; <*$CopyArrays-*> BEGIN RETURN lst.head = sys.ADR(lst.tail) END listIsEmpty; (* Supprime tous les noeuds de la liste et supprime la mémoire associée. *) (* Il faut être sûr que le contenu n'est plus utilisé *) PROCEDURE [0] RemAllFileNodes (headerPtr : E.MinListPtr); <*$CopyArrays-*> VAR nPtr : _FileNodePtr; commonNPtr : E.CommonNodePtr; BEGIN IF ~listIsEmpty(sys.ADR(headerPtr)) THEN REPEAT commonNPtr := E.RemTail (headerPtr^); ConvPtr (commonNPtr, nPtr); (* Supprimer le noeud *) sys.DISPOSE (nPtr); UNTIL commonNPtr=NIL; END; END RemAllFileNodes; (* Retourne le noeud suivant. Si nP est le dernier élément de la liste, retourne NIL *) PROCEDURE [0] getSucc (nP : E.MinNodePtr) : E.MinNodePtr; <*$CopyArrays-*> BEGIN RETURN nP.succ END getSucc; (* Met le noeud suivant dans output. Si nP est le dernier élément de la liste, output vaudra NIL *) PROCEDURE [0] putSucc (nP : E.MinNodePtr ; VAR output : sys.PTR); <*$CopyArrays-*> BEGIN output := sys.VAL(sys.PTR, getSucc(nP)) END putSucc; (* Met l'entête de la liste dans output. *) PROCEDURE [0] putHead (mlp : E.MinListPtr ; VAR output : sys.PTR); <*$CopyArrays-*> BEGIN output := sys.VAL (sys.PTR, mlp.head) END putHead; (* Démarre la notification sur 1 seul fichier seulement si cette notification n'est pas *) (* déjà démarrée. Si le démarrage a réussi, l'indique dans not *) PROCEDURE [0] Notify1 (namePtr : E.LSTRPTR ; VAR not : _notify); <*$CopyArrays-*> BEGIN IF ~not.ok THEN InitMem (sys.ADR(not),SIZE(_notify)); not.n.name := namePtr; (* not.n.userData := 0; *) (* non-utilisé: inutile de l'initialiser... *) not.n.flags := {dos.sendMessage}; (* Réception d'un msg lors d'un évévement *) ConvPtr (NotifyMsgPortPtr, not.n.task); (* port et task sont à la même place... *) not.ok := dos.StartNotify (not.n); (* TRUE en cas de succès *) <* IF TEST THEN *> IF not.ok THEN dos.PrintF ("%s %s%s\n", sys.ADR("-->>not.ok = TRUE"), sys.ADR("namePtr^ = "), namePtr); ELSE dos.PrintF ("%s %s%s\n", sys.ADR("-->>not.ok = FALSE"), sys.ADR("namePtr^ = "), namePtr); END; <* END *> END; END Notify1; (* Supprime la notification si elle a été démarrée avec succès *) PROCEDURE [0] StopNotify1 (VAR n : _notify); <*$CopyArrays-*> BEGIN (* Le test de not.ok est nécessaire, même que dos.EndNotify supporte les cas où *) (* dos.StartNotify a échoué. Si un noeud est rajouté, il n'y a pas forcément tout de *) (* suite un dos.StartNotify. La structure dos.NotifyRequest n'est donc pas initialisée. *) IF n.ok THEN dos.EndNotify (n.n); n.ok := FALSE END; END StopNotify1; (* Supprime le port de message de notification en quittant *) (* Utiliser Kernel.SetCleanup pour cette procédure *avant* NotifyAllNow (pour que le port *) (* soit enlevé après la fin de la notification) *) (* Prend d'éventuels messages restants sur le port *) PROCEDURE [0] RemNotifyPort (VAR RC:LONGINT); <*$CopyArrays-*> VAR NMPtr : dos.NotifyMessagePtr; BEGIN IF NotifyMsgPortPtr # NIL THEN REPEAT ConvPtr (E.GetMsg(NotifyMsgPortPtr), NMPtr); UNTIL NMPtr=NIL; E.DeleteMsgPort (NotifyMsgPortPtr) END END RemNotifyPort; (* Parcourt tous les noeuds et démarre ou arrête la notification suivant la valeur de StartNotify *) PROCEDURE [0] NotifyAllNow (VAR RC:LONGINT); <*$CopyArrays-*> CONST res = 10; (* Caractères de réserve pour dos.AddPart *) dirnL = SIZE(_path)+SIZE(_name)+res; VAR nP : _FileNodePtr; dirnPtr : E.LSTRPTR; short : SHORTINT; BEGIN IF ~listIsEmpty(sys.ADR(FileListHeader)) THEN putHead (sys.ADR(FileListHeader),nP); (* pour chaque noeud *) WHILE getSucc(sys.ADR(nP.node)) # NIL DO IF StartNotify THEN (* Allouer buffer pour chemin + nom de fichier + réserve *) dirnPtr := E.AllocMem (dirnL, {}); IF dirnPtr # NIL THEN (* créer un nom de fichier avac le chemin complet *) COPY (nP.file.path, dirnPtr^); short := sys.VAL(SHORTINT, dos.AddPart (dirnPtr^, nP.file.name, dirnL)); <* IF TEST THEN *> dos.PrintF ("%s%s\n",sys.ADR("dirnPtr = "), dirnPtr); <* END *> (* si la concaténation a réussi, démarrer la notification *) IF short#0 THEN Notify1 (dirnPtr, nP.notify) END; (* plus besoin du nom de fichier *) E.FreeMem (dirnPtr, dirnL); END; ELSE StopNotify1 (nP.notify) END; putSucc (sys.ADR(nP.node), nP); END; END; END NotifyAllNow; (* Appelle NotifiAllNow en mettant Start dans StartNotify *) (* Met ensuite StartNotify à FALSE pour arrêter la notification en cas de Cleanup *) PROCEDURE [0] NotifyAll (Start:BOOLEAN); <*$CopyArrays-*> VAR var : LONGINT; BEGIN (* StartNotifyAllNow doit avoir seulement RC comme paramètre, d'où StartNotify global *) StartNotify := Start; NotifyAllNow (var); StartNotify := FALSE; END NotifyAll; (* Crée une requête à un gadget. Utilise Intuition/EasyRequest si l'interface n'est pas ouverte *) (* (pour permettre la fermeture de la triton.library) *) (* Si l'interface est ouverte, utilise la fonction prévuedans Triton *) PROCEDURE [0] OneGadReq (body: ARRAY OF CHAR); <*$CopyArrays-*> VAR trash : E.ULONG; tags : ARRAY 3 OF U.TagItem; EasyStruct : int.EasyStruct; (* Définitions des messages par requête *) Result : LONGINT; (* Résultat de la requête: est toujours 0 puisqu'il n'y a que 1 gadget *) BEGIN locStrPtr := L.CatStr(okN, okS); (* Localisation de 'ok' *) IF guiOpened THEN tags[0].tag := T.ezTitle; tags[0].data := sys.ADR(winTitle); tags[1].tag := T.ezLockProject; (* La souris sera occupée sur l'interface *) tags[1].data := mainProject; tags[2].tag := U.done; tags[2].data := 0; trash := T.EasyRequest (application, sys.ADR(body), sys.VAL(E.STRPTR, locStrPtr), tags); ELSE EasyStruct.structSize := 20; (* Taille de la structure *) EasyStruct.flags := {}; (* Flags: non-implémenté -> =0 *) EasyStruct.title := sys.ADR(winTitle); (* Titre de la fenêtre *) EasyStruct.textFormat := sys.ADR(body); (* Texte de la fenêtre *) EasyStruct.gadgetFormat := locStrPtr; (* Formatage du textes des gadgets *) Result := int.EasyRequest (NIL, sys.ADR(EasyStruct), NIL, 0); END; END OneGadReq; (* Correspond à (1L << sigBit). Il est nécessaire de multiplier parce que les fonctions de *) (* décalage posent problème pour le bit n°31 *) PROCEDURE [0] ComputeSig (sigBit:SHORTINT): SET; <*$CopyArrays-*> VAR Trash : SHORTINT; Result : LONGINT; BEGIN Trash := sigBit; Result := 1; WHILE Trash>0 DO Result := Result*2; (* Décaler sigBit fois de 1 bit à gauche *) DEC(Trash); END; RETURN sys.VAL(SET,Result); END ComputeSig; (* Supprime le broker ou ce qu'il en existe (Prend d'éventuels messages restants sur le port) *) <*$CopyArrays-*> PROCEDURE BrokerClose (VAR RC: LONGINT); VAR BMPtr : E.MessagePtr; BEGIN IF BrokerPtr # NIL THEN com.DeleteCxObjAll(BrokerPtr) END; IF BrokerPortPtr # NIL THEN LOOP BMPtr := E.GetMsg(BrokerPortPtr); IF BMPtr=NIL THEN EXIT END; E.ReplyMsg (BMPtr) END; E.DeleteMsgPort(BrokerPortPtr) END; END BrokerClose; (* Initialise le broker *) <*$CopyArrays-*> PROCEDURE BrokerInit(): BOOLEAN; VAR Ok : BOOLEAN; Trash : E.LONGBOOL; BEGIN Ok := FALSE; BrokerPtr := NIL; BrokerPortPtr := E.CreateMsgPort(); Kernel.SetCleanup (BrokerClose); IF BrokerPortPtr # NIL THEN NewBroker.version := com.nbVersion; NewBroker.name := sys.ADR(appName); NewBroker.title := sys.ADR(winTitle); NewBroker.descr := sys.ADR(appTitle); NewBroker.unique := sys.VAL(s.SET16,com.unique); NewBroker.flags := sys.VAL(s.SET16,com.showHide); NewBroker.pri := 0; NewBroker.port := BrokerPortPtr; Trash := 0; BrokerPtr := com.CxBroker(NewBroker,Trash); IF BrokerPtr # NIL THEN Trash := com.ActivateCxObj(BrokerPtr,1); BrokerWaitSig := ComputeSig(BrokerPortPtr.sigBit); Ok := TRUE; END; END; RETURN Ok; END BrokerInit; (* Convertit le numéro sélectionné de la liste en pointer sur le neoud correspondant *) <*$CopyArrays-*> PROCEDURE FindNode (num : LONGINT) : _FileNodePtr; VAR i: E.ULONG; nP: _FileNodePtr; BEGIN putHead (sys.ADR(FileListHeader),nP); FOR i := 0 TO num-1 DO putSucc (sys.ADR(nP.node), nP) END; RETURN nP; END FindNode; (* Initialise un nouveau noeud de la liste pour utilisation. *) <*$CopyArrays-*> PROCEDURE InitFileNode (VAR n : _FileNodePtr); BEGIN n.node.succ := NIL; n.node.pred := NIL; n.node.type := E.unknown; n.node.pri := 0; locStrPtr := L.CatStr(emptyN, emptyS); COPY (locStrPtr^, n.file.path); COPY (locStrPtr^, n.file.name); COPY (locStrPtr^, n.file.cmd); n.notify.ok := FALSE; END InitFileNode; (* Tente d'ouvrir l'interface *) <*$CopyArrays-*> PROCEDURE OpenGui(); BEGIN IF ~guiOpened THEN T.OpenLib (T.TRITON20VERSION); IF T.base # NIL THEN application := T.CreateAppTags ( T.caName, sys.ADR(appName), T.caLongName, sys.ADR(appName), T.caRelease, sys.ADR("1.0"), T.caVersion, sys.ADR("38.0"), T.caInfo, sys.ADR(appTitle), T.caDate, sys.ADR("31.03.97"), U.done ); IF application # NIL THEN <* IF TEST THEN *> dos.PrintF ("application créée\n",NIL); <* END *> mainProject := T.OpenProject (application, projTagsPtr^); IF mainProject # NIL THEN guiOpened := TRUE END; <* IF TEST THEN *> ; dos.PrintF ("%s\n",sys.ADR("projet créé")); <* END *> END; IF ~guiOpened THEN locStrPtr := L.CatStr(noTrIntN, noTrIntS); OneGadReq (locStrPtr^); END; ELSE locStrPtr := L.CatStr(noTrLibN, noTrLibS); OneGadReq (locStrPtr^); END; END; END OpenGui; (* Ferme l'interface si elle est ouverte. (Est appelé automatiquement en quittant) *) <*$CopyArrays-*> PROCEDURE CloseGuiNow (VAR RC: LONGINT); VAR msgPtr : T.MessagePtr; BEGIN IF guiOpened THEN LOOP msgPtr := T.GetMsg (application); IF msgPtr = NIL THEN EXIT END; T.ReplyMsg (msgPtr) END END; IF mainProject # NIL THEN T.CloseProject (mainProject); mainProject := NIL END; IF application # NIL THEN T.DeleteApp (application); application := NIL END; guiOpened := FALSE <* IF TEST THEN *> ; dos.PrintF ("%s\n",sys.ADR("fermeture")); <* END *> END CloseGuiNow; (* Ferme l'interface si elle est ouverte. *) <*$CopyArrays-*> PROCEDURE CloseGui (); VAR var : LONGINT; BEGIN CloseGuiNow (var); T.CloseLib (); END CloseGui; (* Ferme l'interface si elle est ouverte. *) <*$CopyArrays-*> PROCEDURE SetlvName (VAR nP : _FileNodePtr); BEGIN (* si la notification est sur un dir, afficher le dir dans le listview, sinon le fichier *) IF nP.file.name[0] = "\0" THEN nP.node.name := sys.ADR(nP.file.path) ELSE nP.node.name := sys.ADR(nP.file.name) END; END SetlvName; (* :: Requête de fichier Asl :: L'ouverture et la fermeture de la asl.library est implémentée. :: path, file : pointeur sur la chaîne de caractère où stocker le chemin ou le nom de fichier :: sizep, sizef : indique la longueur maxi à ne pas dépasser de path et file :: Si file = NIL le chemin et le nom de fichier seront concaténés dans path *) <*$CopyArrays-*> PROCEDURE AslReq (path, file : E.LSTRPTR ; sizep, sizef : LONGINT ; titlePtr : E.LSTRPTR); VAR AslPTags : ARRAY 2 OF U.TagItem; AslReqPtr : asl.FileRequesterPtr; BEGIN asl.OpenLib (); IF asl.base # NIL THEN AslPTags[0].tag := U.done; ConvPtr (asl.AllocAslRequest (asl.fileRequest, AslPTags), AslReqPtr); IF AslReqPtr # NIL THEN AslPTags[0].tag := asl.hail; AslPTags[0].data := titlePtr; AslPTags[1].tag := U.done; (* asl.dir; *) AslPTags[1].data := 0; IF asl.AslRequest (AslReqPtr, AslPTags) THEN IF file # NIL THEN sys.MOVE (AslReqPtr.drawer, path, 1+Util.MinLongint (str.Length(AslReqPtr.drawer^),sizep-1)); sys.MOVE (AslReqPtr.file, file, 1+Util.MinLongint(str.Length(AslReqPtr.file^),sizef-1)); ELSE sys.MOVE (AslReqPtr.drawer, path, 1+Util.MinLongint(str.Length(AslReqPtr.drawer^),sizep-1)); IF dos.AddPart (path^, AslReqPtr.file^, sizep) THEN END; END; <* IF TEST THEN *> dos.PrintF (" %s%s\n %s%s\n %s%s\n", sys.ADR("AslReqPtr.drawer = "), AslReqPtr.drawer, sys.ADR("AslReqPtr.file = "), AslReqPtr.file, sys.ADR("path = "), path); <* END *> END; asl.FreeAslRequest (AslReqPtr); END; asl.CloseLib (); ELSE locStrPtr := L.CatStr(noAslLibN, noAslLibS); OneGadReq (locStrPtr^); END; END AslReq; (* :: retourne TRUE si la config a pu être lue et la liste chaînée correctement :: mise à jour. En cas de manque de mémoire, lit le fichier en partie seulement *) <*$CopyArrays-*> PROCEDURE LoadConfig (headerPtr : E.MinListPtr) : BOOLEAN; (* le pointeur est nécessaire pour ne pas prendre l'adresse du paramètre ! *) (* (il faut demander l'adresse de la chaîne avant l'entrée dans la proc...) *) VAR CommonNodePtr : E.CommonNodePtr; (* var temp... *) FileNodePtr : _FileNodePtr; (* un élément de la liste *) FileHandlePtr : dos.FileHandlePtr; shortint : SHORTINT; (* Vérif du numéro de version *) RealLength : LONGINT; (* longueur effectivement lue *) ok : BOOLEAN; BEGIN ok := FALSE; FileHandlePtr := dos.Open (configLName, dos.oldFile); IF FileHandlePtr # NIL THEN (* pas d'err jusqu'à nouvel avis *) ok := TRUE; (* Lire numéro de version *) RealLength := dos.Read (FileHandlePtr, shortint, 1); (* Si le numéro a pu être lu et la version correspond *) IF (RealLength = 1) & (shortint = internalVer) THEN REPEAT RealLength := 0; (* libération en quittant *) NEW (FileNodePtr); IF FileNodePtr # NIL THEN InitFileNode (FileNodePtr); (* lecture de l'entrée suivante *) RealLength := dos.Read (FileHandlePtr, FileNodePtr.file, SIZE(_File)); (* si la longueur est juste, on remplit le neoud *) (* si la longueur n'est pas juste, on a atteint la fin *) (* du fichier ou le fichier est corrompu. *) IF RealLength = SIZE(_File) THEN SetlvName (FileNodePtr); (* ajout du noeud en fin de liste *) E.AddTail (headerPtr^, sys.VAL(E.CommonNodePtr, FileNodePtr)); ELSE sys.DISPOSE (FileNodePtr); IF RealLength # 0 THEN (* Supprimer les noeuds existants *) RemAllFileNodes (headerPtr); <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("fichier corrompu")); <* END *> (* fichier corrompu: le nombre d'enregistrements n'est pas entier *) locStrPtr := L.CatStr(prfCrptN, prfCrptS); OneGadReq (locStrPtr^); ok := FALSE END; END; ELSE (* manque de ram pour charger la cfg *) <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("manque de ram")); <* END *> ok := FALSE END; (* jusqu'au dernier rec *) UNTIL RealLength # SIZE(_File); ELSE ok := FALSE; locStrPtr := L.CatStr(prfCrptN, prfCrptS); OneGadReq (locStrPtr^); END; (* if (RealLength=1) & (shortint=internalVer) *) dos.OldClose (FileHandlePtr); END; RETURN ok; END LoadConfig; (* :: retourne TRUE si la config a pu être sauvée. *) <*$CopyArrays-*> PROCEDURE SaveConfig (headerPtr : E.MinListPtr; Envarc: BOOLEAN) : BOOLEAN; (* le pointeur est nécessaire pour ne pas prendre l'adresse du paramètre ! *) (* (il faut demander l'adresse de la chaîne avant l'entrée dans la proc...) *) VAR FileNodePtr : _FileNodePtr; (* un élément de la liste *) FileNodePtr2 : _FileNodePtr; (* un élément de la liste *) FileHandlePtr : dos.FileHandlePtr; shortint : SHORTINT; (* Enregistrement du numéro de version *) RealLength : LONGINT; (* longueur effectivement lue *) ok : BOOLEAN; cfgName : POINTER TO ARRAY OF CHAR; BEGIN ok := FALSE; (* sélection Env: Envarc: *) sys.PUT (sys.ADR(cfgName),sys.ADR(configLName)); IF Envarc THEN sys.PUT(sys.ADR(cfgName),sys.ADR(configSName)) END; FileHandlePtr := dos.Open (cfgName^, dos.newFile); IF FileHandlePtr # NIL THEN (* pas d'err jusqu'à nouvel avis *) ok := TRUE; (* écriture du numéro de version *) shortint := internalVer; RealLength := dos.Write (FileHandlePtr, shortint, 1); (* Si l'écriture a fonctionné, continuer *) IF RealLength = 1 THEN (* pointer sur 1er noeud *) putHead (headerPtr, FileNodePtr); (* pour chaque noeud *) LOOP putSucc (sys.ADR(FileNodePtr.node), FileNodePtr2); IF FileNodePtr2 = NIL THEN EXIT END; (* écriture de l'entrée suivante *) RealLength := dos.Write (FileHandlePtr, FileNodePtr.file, SIZE(_File)); (* arrêter écriture en cas d'erreur *) IF RealLength # SIZE(_File) THEN <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("err de fichier en écriture")); <* END *> locStrPtr := L.CatStr(cfgSErrN, cfgSErrS); OneGadReq (locStrPtr^); ok := FALSE; EXIT; END; (* noeud suivant *) FileNodePtr := FileNodePtr2; END; ELSE ok := FALSE; locStrPtr := L.CatStr(cfgSErrN, cfgSErrS); OneGadReq (locStrPtr^); END; (* if (RealLength=1) *) dos.OldClose (FileHandlePtr); END; RETURN ok; END SaveConfig; <*$CopyArrays-*> PROCEDURE ManageGui (Open : BOOLEAN); (* Ouvre l'interface immédiatement si Open *) VAR signals : SET; messagePtr : T.MessagePtr; eventID : E.ULONG; eventclass : E.ULONG; eventcode : E.ULONG; eventdata : E.ULONG; quit : BOOLEAN; BrokerMsgPtr : E.MessagePtr; BrokerMsgType : SET; BrokerMsgID : LONGINT; lstrptr : E.LSTRPTR; longbool : E.LONGBOOL; nodePtr : _FileNodePtr; (* rajout d'un noeud dans la liste (New) *) commonNodePtr : E.CommonNodePtr; (* pour la suppression des enregistrements *) NotifyMsgPtr : dos.NotifyMessagePtr; ctrlCWaitSig : SET; (* bit à attendre pour recevoir le control-c *) (* Met à jour les 2 string gadgets en fonction de l'entrée sélectionnée *) (* Si la liste est vide, ombre ces deux gadgets *) <*$CopyArrays-*> PROCEDURE UpdateStrGetfGads (selected : E.ULONG); VAR nodePtr : _FileNodePtr; (* ne pas confondre avec l'autre *) BEGIN (* S'il existe au moins un noeud *) IF ~listIsEmpty(sys.ADR(FileListHeader)) THEN (* faire pointer nodePtr sur l'entrée sélectionnée *) nodePtr := FindNode (selected); (* Il y a au moins une entrée; activer les gadgets *) T.SetAttribute (mainProject, fileStrID, T.atDisabled, 0); T.SetAttribute (mainProject, exeStrID, T.atDisabled, 0); T.SetAttribute (mainProject, pathStrID, T.atDisabled, 0); T.SetAttribute (mainProject, getffileID, T.atDisabled, 0); T.SetAttribute (mainProject, getfexeID, T.atDisabled, 0); (* mettre à jour les string gadgets d'après l'entrée sélectionnée dans le lv *) T.SetAttribute (mainProject, pathStrID, 0, sys.ADR(nodePtr.file.path)); T.SetAttribute (mainProject, fileStrID, 0, sys.ADR(nodePtr.file.name)); T.SetAttribute (mainProject, exeStrID, 0, sys.ADR(nodePtr.file.cmd)); ELSE (* aucune entree dans la liste: désactiver les string-gadgets et les getfiles. *) T.SetAttribute (mainProject, getffileID, T.atDisabled, 1); T.SetAttribute (mainProject, getfexeID, T.atDisabled, 1); T.SetAttribute (mainProject, pathStrID, T.atDisabled, 1); T.SetAttribute (mainProject, fileStrID, T.atDisabled, 1); T.SetAttribute (mainProject, exeStrID, T.atDisabled, 1); END; END UpdateStrGetfGads; (* Sauve le contenu des string gadgets *) <*$CopyArrays-*> PROCEDURE SaveStrGads (selected : E.ULONG); VAR nodePtr : _FileNodePtr; (* ne pas confondre avec l'autre *) lstrptr : E.LSTRPTR; lstrptr2 : E.LSTRPTR; ulong : E.ULONG; BEGIN (* S'il existe au moins un noeud *) IF ~listIsEmpty(sys.ADR(FileListHeader)) THEN (* faire pointer nodePtr sur l'entrée sélectionnée *) nodePtr := FindNode (selected); locStrPtr := L.CatStr(emptyN, emptyS); lstrptr := sys.VAL (E.LSTRPTR, T.GetAttribute (mainProject, pathStrID, 0)); COPY (lstrptr^, nodePtr.file.path); <* IF TEST THEN *> IF nodePtr.file.path[0] = "\0" THEN COPY (locStrPtr^, nodePtr.file.path); END; <* END *> (* Déterminer s'il existe un chemin *) lstrptr := sys.VAL (E.LSTRPTR, T.GetAttribute (mainProject, fileStrID, 0)); COPY (lstrptr^, nodePtr.file.name); <* IF TEST THEN *> dos.PrintF ("%s%s\n", sys.ADR("-->>Path updaté : path = "), sys.ADR(nodePtr.file.path)); <* END *> lstrptr := sys.VAL (E.LSTRPTR, T.GetAttribute (mainProject, exeStrID, 0)); COPY (lstrptr^, nodePtr.file.cmd); <* IF TEST THEN *> IF nodePtr.file.cmd[0] = "\0" THEN COPY (locStrPtr^, nodePtr.file.cmd); END; <* END *> SetlvName (nodePtr); END; END SaveStrGads; (* Met à jour les 2 string gadgets en fonction de l'entrée sélectionnée *) (* Si la liste est vide, ombre ces deux gadgets *) <*$CopyArrays-*> PROCEDURE Execute (fP : _FilePtr); CONST run = "Run <nil: "; runsize = 12; VAR cmdLinePtr : E.LSTRPTR; BEGIN (* Si la commande existe *) IF fP.cmd[0] # "\0" THEN (* Allocation de place pour la commande. *) cmdLinePtr := E.AllocMem (SIZE(_cmd)+runsize, {}); IF cmdLinePtr # NIL THEN (* La commande est lancée en tâche de fond. *) (* La sortie est dirigée vers nil sauf si la commande la redirige *) COPY (run, cmdLinePtr^); (* Copie de la commande après le "Run <nil: " *) sys.MOVE (sys.ADR(fP.cmd), sys.VAL(LONGINT,cmdLinePtr)+runsize-1, LEN(fP.cmd)); <* IF TEST THEN *> dos.PrintF ("%s%s\n",sys.ADR("cmdLinePtr^ = "), cmdLinePtr); <* END *> (* Exécution de la commande *) IF ~dos.Execute (cmdLinePtr^, NIL, dos.Output()) THEN (* Message si la commande ne peut pas être lancée *) locStrPtr := L.CatStr(exeErrN, exeErrS); OneGadReq (locStrPtr^); END; (* Libération de la mémoire de la commande *) E.FreeMem (cmdLinePtr, SIZE(_cmd)+runsize); END; END; END Execute; BEGIN (* ManageGui *) mainProject := NIL; application := NIL; guiOpened := FALSE; Kernel.SetCleanup (CloseGuiNow); actlvID := 0; (* devra être initialisé par LoadConfig *) ctrlCWaitSig := ComputeSig (dos.ctrlC); quit := FALSE; IF Open THEN OpenGui(); IF guiOpened THEN T.SetAttribute (mainProject, lvID, T.atValue, actlvID); UpdateStrGetfGads (actlvID); ELSE quit := TRUE; END; END; WHILE ~quit DO (* Fenêtre ouverte: fonction d'attente de trition *) IF guiOpened THEN signals := sys.VAL(SET, T.Wait(application, sys.VAL(E.ULONG,BrokerWaitSig+NotifyWaitSig+ctrlCWaitSig))); <* IF TEST THEN *> (* dos.PrintF ("%s%lx\n",sys.ADR("signaux reçus = $"), signals); *) <* END *> ELSE signals := E.Wait (BrokerWaitSig+NotifyWaitSig+ctrlCWaitSig) END; IF ctrlCWaitSig = ctrlCWaitSig*signals THEN <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR("dos.CtrlC\n")); <* END *> quit := TRUE; END; (* Signaux reçus des notifications *) IF NotifyWaitSig = NotifyWaitSig*signals THEN LOOP ConvPtr (E.GetMsg(NotifyMsgPortPtr), NotifyMsgPtr); IF NotifyMsgPtr=NIL THEN EXIT END; <* IF TEST THEN *> dos.PrintF ("%s%lx\n", sys.ADR("===>>>NotifyMsgPtr = $"), NotifyMsgPtr); <* END *> IF listIsEmpty(sys.ADR(FileListHeader)) THEN EXIT END; putHead (sys.ADR(FileListHeader), nodePtr); WHILE (getSucc(sys.ADR(nodePtr.node)) # NIL) & (NotifyMsgPtr.nReq # sys.ADR(nodePtr.notify.n)) DO putSucc (sys.ADR(nodePtr.node), nodePtr) END; <* IF TEST THEN *> ; dos.PrintF ("%s %s %s\n", sys.ADR("-->>"), sys.ADR(nodePtr.file.name), sys.ADR(nodePtr.file.cmd)); <* END *> (* Exécuter la commande contenue dans le noeud *) Execute (sys.VAL(_FilePtr, sys.ADR(nodePtr.file))); END; (* loop *) END; (* IF NotifyWaitSig = NotifyWaitSig*signals THEN *) (* Signaux reçus des commodités *) IF BrokerWaitSig = BrokerWaitSig*signals THEN LOOP BrokerMsgPtr := E.GetMsg(BrokerPortPtr); IF BrokerMsgPtr=NIL THEN EXIT END; BrokerMsgType := com.CxMsgType(sys.VAL(com.CxMsgPtr,BrokerMsgPtr)); BrokerMsgID := com.CxMsgID(sys.VAL(com.CxMsgPtr,BrokerMsgPtr)); E.ReplyMsg (BrokerMsgPtr); IF BrokerMsgType=sys.VAL(SET,com.cxmCommand) THEN CASE BrokerMsgID OF com.cmdDisappear: CloseGui (); <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR("Hide\n")); <* END *> | com.cmdAppear: OpenGui(); IF guiOpened THEN T.SetAttribute (mainProject, lvID, T.atValue, actlvID); UpdateStrGetfGads (actlvID); END; <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR("Show\n")); <* END *> | com.cmdDisable: longbool := com.ActivateCxObj(BrokerPtr,0); NotifyAll (FALSE); | com.cmdEnable: longbool := com.ActivateCxObj(BrokerPtr,1); NotifyAll (TRUE); | com.cmdKill: <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR("Kill\n")); <* END *> quit := TRUE; ELSE (* CASE (BrokerMsgID) OF *) <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR(">>>>>>>> ManageGui: Unknown Broker ID <<<<<<<<<\n")); <* END *> END; (* CASE (BrokerMsgID) OF *) END; (* IF (BrokerMsgType=com.mCommand) *) END; (* LOOP *) END; (* IF BrokerWaitSig = BrokerWaitSig*signals *) (* test du message reçu de Triton *) (* On ne sait pas de quel(s) bit(s) de signal il s'agit: on teste le msg à chaque fois *) LOOP IF ~guiOpened THEN EXIT END; messagePtr := T.GetMsg (application); IF messagePtr = NIL THEN EXIT END; <* IF TEST THEN *> dos.PrintF ("%s%lx\n",sys.ADR("messagePtr = $"), messagePtr); <* END *> IF messagePtr.project = mainProject THEN <* IF TEST THEN *> dos.PrintF ( "%s%-lx\n" "%s%-lx\n" "%s%-ld\n" "%s%-lx\n" "%s%-lx\n" "%s%-lx\n" "%s%-lx\n" "%s%-ld\n" "%s%-ld\n" "%s%-lx\n" "%s%-lx\n", sys.ADR("mainProject = $"), mainProject, sys.ADR("messagePtr.project = $"), messagePtr.project, sys.ADR("messagePtr.ID = "), messagePtr.id, sys.ADR("messagePtr.class = $"), messagePtr.class, sys.ADR("messagePtr.data = $"), messagePtr.data, sys.ADR("messagePtr.code = $"), messagePtr.code, sys.ADR("messagePtr.qualifier = $"), messagePtr.qualifier, sys.ADR("messagePtr.seconds = "), messagePtr.seconds, sys.ADR("messagePtr.micros = "), messagePtr.micros, sys.ADR("application = $"), application, sys.ADR("messagePtr.app = $"), messagePtr.app); <* END *> eventID := messagePtr.id; eventclass := messagePtr.class; eventcode := messagePtr.code; eventdata := messagePtr.data; T.ReplyMsg (messagePtr); <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("message retourné")); <* END *> CASE eventclass OF (* équivalent à Hide *) T.msCloseWindow: CloseGui (); (* action ou modification des gadgets *) | T.msAction, T.msNewValue: (* Suivant gadget affecté *) CASE eventID OF (* Sélection d'un élément de la liste *) lvID: <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("-->lv")); <* END *> (* stocker les modifs dans les strings *) SaveStrGads (actlvID); <* IF TEST THEN *> dos.PrintF ("%s%ld\n",sys.ADR("eventdata = "), eventdata); <* END *> (* stocker nouvelle sélection *) actlvID := eventdata; (* mettre à jour gadget pour la nouvelle sélection *) UpdateStrGetfGads (eventdata); (* modification à la main du chemin du fichier *) | pathStrID, fileStrID: (* stocker les modifs dans les strings *) SaveStrGads (actlvID); (* mettre à jour gadget listview *) T.SetAttribute (mainProject, lvID, 0, sys.VAL(E.ULONG,sys.ADR(FileListHeader))); (* Mettre à jour strings. p.ex.: Temp:aa/bb -> bb *) UpdateStrGetfGads (actlvID); (* Requête de fichier pour le fichier ou la commande *) | getffileID, getfexeID: (* Rechercher position de la sélection actuelle *) nodePtr := FindNode(actlvID); (* Demander nouveau ficher *) T.LockProject (mainProject); IF eventID = getffileID THEN AslReq (sys.ADR(nodePtr.file.path), sys.ADR(nodePtr.file.name), SIZE(_path), SIZE(_name), sys.ADR(winTitle)); ELSE AslReq (sys.ADR(nodePtr.file.cmd), NIL, SIZE(_cmd), 0, sys.ADR(winTitle)); END; T.UnlockProject (mainProject); SetlvName (nodePtr); (* mettre à jour gadget listview *) T.SetAttribute (mainProject, lvID, 0, sys.VAL(E.ULONG,sys.ADR(FileListHeader))); (* Mettre à jour strings *) UpdateStrGetfGads (actlvID); (* Exécution de la commande sélectionnée *) | exebuttID: (* stocker les modifs dans les strings *) SaveStrGads (actlvID); (* Rechercher position de la sélection actuelle *) nodePtr := FindNode (actlvID); Execute (sys.VAL(_FilePtr, sys.ADR(nodePtr.file))); (* Ajout d'une nouvelle entrée dans la liste *) | newbuttID: <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("-->New")); <* END *> (* ne pas disposer nodePtr (est un élément de la liste) *) NEW (nodePtr); IF nodePtr # NIL THEN InitFileNode (nodePtr); SetlvName (nodePtr); (* ajout du noeud en fin de liste *) E.AddTail (FileListHeader, sys.VAL(E.CommonNodePtr, nodePtr)); (* mettre à jour le listview *) T.SetAttribute (mainProject, lvID, 0, sys.VAL(E.ULONG,sys.ADR(FileListHeader))); (* mettre strings à jour en fonction de l'entrée sélectionnée *) actlvID := T.GetAttribute (mainProject, lvID, T.atValue); UpdateStrGetfGads (actlvID); ELSE locStrPtr := L.CatStr(noMemN, noMemS); OneGadReq (locStrPtr^); END; (* Effaçage d'une entrée de la liste *) | delbuttID: (* S'il existe encore un noeud *) IF ~listIsEmpty(sys.ADR(FileListHeader)) THEN (* Rechercher position de la sélection actuelle *) nodePtr := FindNode (actlvID); (* Suppression du noeud de la liste *) E.Remove (sys.VAL(E.CommonNodePtr, nodePtr)); (* Supprimer la notification correspondant au noeud *) StopNotify1 (nodePtr.notify); (* Supprimer le noeud de la mémoire *) sys.DISPOSE (nodePtr); (* mettre à jour gadget listview *) T.SetAttribute (mainProject, lvID, 0, sys.VAL(E.ULONG,sys.ADR(FileListHeader))); (* mettre strings à jour en fonction de l'entrée sélectionnée *) actlvID := T.GetAttribute (mainProject, lvID, T.atValue); UpdateStrGetfGads (actlvID); END; (* Sauvegarde définitive des modifs *) | savebuttID, usebuttID: (* stocker les modifs dans les strings *) SaveStrGads (actlvID); NotifyAll (FALSE); NotifyAll (TRUE); IF eventID = savebuttID THEN IF ~SaveConfig (sys.ADR(FileListHeader), envarc) THEN locStrPtr := L.CatStr(SEnvarcErrN, SEnvarcErrS); OneGadReq (locStrPtr^); END; END; IF ~SaveConfig (sys.ADR(FileListHeader), env) THEN locStrPtr := L.CatStr(SEnvErrN, SEnvErrS); OneGadReq (locStrPtr^); END; CloseGui (); EXIT; (* Cachage de la fenêtre *) | hidebuttID: CloseGui (); <* IF TEST THEN *> dos.PrintF ("%s", sys.ADR("Hide\n")); <* END *> EXIT; (* Annulation des modifs (rechargement de l'ancien fichier de prefs) *) | cancbuttID: NotifyAll (FALSE); (* S'il existe encore des noeuds tous les supprimer *) RemAllFileNodes (sys.ADR(FileListHeader)); (* Charger l'ancienne config *) IF ~LoadConfig (sys.ADR(FileListHeader)) THEN locStrPtr := L.CatStr(SEnvErrN, SEnvErrS); OneGadReq (locStrPtr^); END; CloseGui (); NotifyAll (TRUE); EXIT; ELSE (* CASE eventID OF *) <* IF TEST OR BETA THEN *> dos.PrintF (">>>>>>>> eventID inconnu <<<<<<<<<\n", NIL); <* END *> END; (* CASE eventID OF *) | T.msError: <* IF TEST OR BETA THEN *> dos.PrintF (">>>>>>>> ERREUR de TRITON <<<<<<<<<\n", NIL); <* END *> locStrPtr := L.CatStr(intTrErrN, intTrErrS); OneGadReq (locStrPtr^); quit := TRUE; ELSE (* CASE eventclass OF *) END; (* Autre projet Triton: ne devrait jamais arriver ! *) ELSE (* if messagePtr.project = mainProject *) <* IF TEST OR BETA THEN *> dos.PrintF ("%s\n",sys.ADR(">>>>>>>> AUTRE PROJECT !! <<<<<<<<<<")); <* END *> T.ReplyMsg (messagePtr); END; (* if messagePtr.project = mainProject *) END; (* LOOP *) END; (* WHILE ~quit *) END ManageGui; <*$CopyArrays-*> BEGIN Errors.Init; GetTT (); L.OpenCat ("MultiNotify.catalog", internalVer); NEW (projTagsPtr); IF projTagsPtr#NIL THEN IF BrokerInit() THEN NotifyMsgPortPtr := E.CreateMsgPort (); IF NotifyMsgPortPtr # NIL THEN Kernel.SetCleanup (RemNotifyPort); NotifyWaitSig := ComputeSig (NotifyMsgPortPtr.sigBit); InitGuiTags (projTagsPtr^); InitHeader (); IF ~LoadConfig (sys.ADR(FileListHeader)) THEN openNow := TRUE END; NotifyAll (TRUE); Kernel.SetCleanup (NotifyAllNow); ManageGui (openNow); <* IF TEST THEN *> dos.PrintF ("%s\n",sys.ADR("fin du prog")); <* END *> END; END; END; END Main.